Projet INFO0808 – Visualisation de données

Introduction

    Dans le cadre du module de visualisation de données, nous avions abordé l’analyse exploratoire et pris en main des outils permettant de générer des graphiques grâce au langage R, à partir d’un ou plusieurs jeux de données de notre choix. Nous avions choisi de travailler sur des données statistiques portant sur le thème de l’animation japonaise. Ces données nous ont permis de créer un bon nombre de graphiques représentatifs. En revanche nous ne possédions pas de rapport ou interface graphique générable par R. Ce projet de visualisation consistait donc à utiliser les outils R adapter afin de décrire nos jeux de donnée par le biais de graphique adapter puis en créer un rendus R markdown permettant une bonne visualisation de ces graphiques. Enfin une petite interface graphique R Shiny était demandée afin de d’apprendre à utiliser cet outil et mettre en place une interface plus ergonomique.

Importation et nettoyage des données

Import des packages :

library(tidyverse)
library(knitr)
library(rmarkdown)
library(markdown)
library(data.table)
library(plotly)
library(viridis)
library(hrbrthemes)
library(lubridate)
library(highcharter)
library(shiny)
library(shinydashboard)

Chargement des jeux de données :

df_anime <- fread(file='datasets/anime_filtered.csv')
df_users <- fread(file='datasets/users_filtered.csv')

Ajout de variables aux jeux de données :

# Colonne age des utilisateurs
users <- df_users[df_users$gender %in% c('Female', 'Male') & !is.null(df_users$birth_date)] %>% 
  select(username, gender, user_completed, user_days_spent_watching, birth_date)

users$age <- as.period(interval(start = users$birth_date, end = as.Date(now())))$year

# Dataset et nouvelles colonnes pour le graphe de densité par décennie
date_data <- df_anime %>% 
  rowwise() %>% 
  mutate(aired = str_extract_all(aired, "(None|[0-9]*-[0-9]+-[0-9]+)")[[1]][1]) %>% 
  ungroup() %>%
  mutate(
    year = as.integer(if_else(nchar(aired) == 10, substr(aired, 1, 4), NULL)),
    month = as.integer(if_else(nchar(aired) == 10, substr(aired, 6, 7), NULL)),
    season = if_else(month %in% c(1:3), 'Winter',
                     if_else(month %in% c(4:6), 'Spring',
                             if_else(month %in% c(7:9), 'Summer', 
                                     if_else(month %in% c(10:12), 'Autumn', NULL)))),
    year_season = paste(year, season),
    decade = as.factor(if_else(!is.na(year), 
                               paste(substr(year, 1, 3), "0's", sep = ''), NULL))
  ) %>% 
  arrange(year, month)

# Valeur médiane pour les boxplots
median_val <- df_anime %>% 
  select(scored_by, score) %>% 
  filter(scored_by > 99) %>% 
  summarize(median_sc = median(score))

# Extraire durée en minutes
duration_data <- df_anime %>% 
  mutate(h = if_else(str_detect(duration, "[0-9]*(?= hr.)"),
                         as.numeric(str_extract(duration, "[0-9]*(?= hr.)")), 0),
         m = if_else(str_detect(duration, "[0-9]*(?= min.)"),
                           as.numeric(str_extract(duration, "[0-9]*(?= min.)")), 0),
         s = if_else(str_detect(duration, "[0-9]*(?= sec.)"),
                           as.numeric(str_extract(duration, "[0-9]*(?= sec.)")), 0),
         duration = h*60 + m + s/60,
         duration = na_if(duration, 0))

Représentation graphique

Graphique n°1 :

line_nb_year <- date_data %>% 
  filter(!is.na(year)) %>% 
  group_by("Year" = year) %>% 
  summarise(Freq = n()) %>%
  ggplot(aes(x = Year, y = Freq)) +
  geom_line(color = 'red', size = 1) +
  theme_ipsum() +
  theme(axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14)) +
  scale_x_continuous(
    expand = c(0, 0),
    limits = c(1910, 2017),
    breaks = seq(1910, 2017, 25)
  ) +
  scale_y_continuous(
    breaks = seq(0, 1000, 250),
    limits = c(0, 1000)
  ) +
  ggtitle("Number of anime per year")

line_nb_year <- ggplotly(line_nb_year)
line_nb_year

    Ce graphique (line chart) représente l’évolution du nombre d’anime sortis par année. Le line chart est une bonne représentation de l’évolution (non-cyclique) d’une variable au fil du temps. En l’occurrence, il suffit d’un coup d’œil pour réaliser que le nombre de productions ne cesse de croître au fil des années.

Graphique n°2 :

data_pie_type <- df_anime %>% 
  filter(type != "Unknown") %>% 
  group_by("Type" = type) %>% 
  summarise(Freq = n())
    
highchart() %>% 
  hc_add_series( data_pie_type, hcaes(x = Type,y = Freq, color = Type), type = "pie") %>%
  hc_tooltip(borderWidth = 1.5, headerFormat = "",
  pointFormat = paste("<b>Type: {point.Type}</b> ({point.percentage:.1f}%)<br><b>Count:</b> {point.y}"))

    Ce diagramme circulaire permet de représenter un petit nombre de valeurs par des angles proportionnels à ces dernières. Il indique la proportion des différents types d’anime, leur part parmi l’ensemble total des anime compris dans le jeu de données. Ici, on peut constater que le type TV (= séries d’animation diffusées à la télévision) représente une majorité d’anime, à savoir 29,6% d’entre eux, contrairement aux clips musicaux dont la part est de 5,9% seulement.

Graphique n°3 :

score_source <- df_anime %>% 
  filter(airing == F & scored_by > 99) %>%
  select(score, scored_by, source) %>%
  ggplot(aes(x = source, y = score)) +
  geom_boxplot(fill = 'deepskyblue') + 
  geom_hline(aes(yintercept = median_val[[1]], linetype = 'median')) +
  scale_linetype_manual(name = '', values = c(median = 'dashed')) +
  coord_flip() + 
  theme_ipsum() +
  theme(
    axis.title.x = element_text(size=14),
    axis.title.y = element_blank(),
  ) +
  scale_y_continuous(limits = c(0, 10)) +
  ggtitle('Score Distribution by Source')

score_source <- ggplotly(score_source)
score_source

    Ce graphique « boîte à moustaches » (box plot) permet d’obtenir un aperçu des données mesurées très rapidement, ici la distribution des notes par source (un anime peut être une production originale, mais il est généralement l’adaptation d’une œuvre déjà existante).

Pour chaque « boîte », et donc chaque source, nous avons :
- Sa médiane (barre verticale à l’intérieure de la boîte) ;
- Les premier et troisième quartiles (respectivement les bords gauche et droit de la boîte);
- Les bornes inférieure et supérieure (respectivement le début et la fin du segment);
- Les valeurs potentiellement aberrantes (parfois des erreurs de saisie) sont représentées par les points noirs à gauche et/ou à droite de chaque segement.

    Chaque borne inférieure est déterminée par ce calcul : Q1 – (1.5 * IQR) où Q1 est le premier quartile et IQR l’écart inter-quartile (Q3 - Q1). Si la valeur minimale de la distribution est supérieure au résultat donné par ce calcul, elle fera office de borne inférieure. Le calcul de la borne supérieure est assez similaire : Q3 + (1.5 * IQR). De la même manière, si la valeur maximale de la distribution est inférieure au résultat produit par ce calcul, elle fera office de borne supérieure. Nous avons également ajouté une ligne en pointillé réprésentant la médiane globale, de tous les anime, indépendamment de la source.

    Prenons l’example des manga numériques (digital manga) comme source, nous remarquons que la médiane se situe très à gauche de la boîte, même très proche du Q1 ou de la borne inférieure, ce qui représente une asymétrie très importante. En revanche, il ne semble y avoir aucune valeur potentiellement aberrante (pas de points noirs visibles), les bornes inférieure et supérieure sont donc déterminées respectivement par les valeurs minimum et maximum de la distribution.Les anime adaptés de manga sont qui atteignent les notes les plus hautes, suivis de très près par les adaptation de light novels dont même le premier quartile Q1 est supérieur à la médiane globale !

Graphique n°4 :

score_type <- df_anime %>% 
  filter(airing == F & scored_by > 99) %>%
  select(score, scored_by, type) %>%
  ggplot(aes(x = type, y = score)) +
  geom_boxplot(fill = 'deepskyblue') + 
  geom_hline(aes(yintercept = median_val[[1]], linetype = 'median')) +
  scale_linetype_manual(name = '', values = c(median = 'dashed')) +
  coord_flip() + 
  theme_ipsum() +
  theme(
    axis.title.x = element_text(size = 14),
    axis.title.y = element_blank(),
  ) +
  scale_y_continuous(limits = c(0, 10)) +
  ggtitle('Score Distribution by Type')

score_type <- ggplotly(score_type)
score_type

    Il s’agit du même type de graphique que ci-dessus, ainsi la logique à suivre est la même, seulement il s’agit ici de la distribution des notes par type. Nous pouvons, par exemple, remarquer que les clips musicaux ainsi que les ONA (Original net animation, des productions directement diffusées sur internet, sur des plateformes de streaming) sont généralement moins bien notés que les autres. D’autre part, les séries d’animation diffusées à la télévision et les films s’en sortent beaucoup mieux.

Graphique n°5 :

rs_score_notes <- df_anime %>%
  filter(airing == F & scored_by > 99) %>%
  ggplot(aes(x = scored_by, y = score)) +
  stat_bin_hex(bins = 50) +
  theme_ipsum() +
  scale_fill_viridis() +
  stat_smooth(
    method = 'lm',
    color = 'red',
    formula = y ~ log(x)
  ) +
  theme(
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14)
  ) +
  scale_y_continuous(
    limits = c(2, 9.5),
    breaks = seq(2, 9.5)
  ) +
  labs(title = 'Relationship between Score and Scored_by', x = "Scored by # people", y = "Score")

rs_score_notes <- ggplotly(rs_score_notes)
rs_score_notes

    Grâce au graphique ci-dessus, il est possible de faire correspondre à l’intensité d’une grandeur variable une gamme de tons de couleurs. Il divise le plan en hexagones qui comptent le nombre de groupes d’anime (ici un groupe = 50 animes). Il ne s’agit que d’un choix arbitraire pour représenter au mieux les données, l’intérêt ici est avant tout de montrer la relation entre le score d’un anime et le nombre de notes attribuées à ce dernier. Le graphique dégage une tendance, en effet plus un anime est noté par un grand nombre d’utilisateurs, plus il est susceptible d’être très bien noté.

TV ANIME

Graphique n°6 :

score_year_tv <- date_data %>% 
  filter(score != 0, scored_by > 10, type == 'TV') %>% 
  group_by("Year" = year) %>% 
  summarise(avg = round(mean(score, na.rm = T), 2)) %>%
  ggplot(aes(x = Year, y = avg)) +
  geom_line(color = 'red', size = 1) +
  theme_ipsum() +
  theme(axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14)) +
  scale_x_continuous(
    expand = c(0, 0),
    limits = c(1960, 2017),
    breaks = seq(1960, 2017, 10)
  ) +
  scale_y_continuous(
    breaks = seq(6, 7.5, 0.2),
    limits = c(6, 7.5)
  ) +
  labs(title = "Average score per year", y = "Average score")

score_year_tv <- ggplotly(score_year_tv)
score_year_tv

    Ce line chart représente l’évolution des notes au cours du temps. La moyenne des notes attribuées à des productions datant des années 1978 ou 1996 est très haute, contrairement à 1965 dont la moyenne est au plus bas. On remarque également une chute notable durant les années 2010.

Graphique n°7 :

ratings_tv_decade <- date_data %>%
  filter(!is.na(decade), type == "TV") %>% 
  group_by("Decade" = decade, rating, .drop = T) %>% 
  summarise(Freq = n()) %>%
  ggplot(aes(x = Decade, y = Freq, group = rating, shape = rating, color = rating)) +
  geom_line(size = 1) +
  geom_point(size = 2) +
  theme_ipsum() +
  theme(axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14)) +
  scale_y_continuous(
    breaks = seq(0, 1250, 250),
    limits = c(0, 1250)
  ) +
  ggtitle("Ratings evolution during decades")

ratings_tv_decade <- ggplotly(ratings_tv_decade)
ratings_tv_decade

    Ce graphique représente l’évolution de la classification au fil des décennies. On remarque rapidement que les productions ciblant un public agé de 13 ans ou plus sont de plus en plus nombreuses.

Graphique n°8 :

bbl_chart <- df_anime[df_anime$popularity != 0] %>% 
  arrange(popularity) %>% head(n = 100) %>%
  select(popularity, rank, title, scored_by, favorites, score) %>%
  filter(popularity <= 100) %>%
  mutate(point = (as.numeric(scored_by) * as.numeric(favorites) * as.numeric(score)) / 10^10) %>% 
  ggplot(aes(x = rank, y = popularity, size = point, color = popularity, text = title)) +
  geom_point(alpha = 0.7) +
  scale_size(range = c(0, 19)) +
  scale_color_viridis() +
  theme_ipsum() +
  theme(
    axis.title.x = element_text(size = 14),
    axis.title.y = element_text(size = 14)
  ) +
  scale_x_continuous(
    limits = c(0, 100),
    breaks = seq(0, 100, 10)
  ) +
  scale_y_continuous(
    limits = c(-5, 100),
    breaks = seq(0, 100, 25)
  ) +
  labs(title='TOP 100 Anime by rank and popularity', x = 'Rank', y = 'Popularity')

bbl_chart <- ggplotly(bbl_chart, tooltip = c('rank', 'popularity', 'title'))
bbl_chart

    Ce bubble chart représente les 100 animes les plus populaires. Ils sont représentés en fonction de leur rang dans le classement et de leur popularité. Le choix de ce type de graphique repose également sur une troisième variable qui s’ajoute au deux précentes, une variable point dont la formule se base sur le nombre de notes attribuées, le score ainsi que le nombre d’utilisateur ayant cet anime dans ses favoris. Elle sert à déterminer la taille de chaque bulle (donc la taille minimale est fixe dans le code).

    On peut constater qu’en s’appuyant les effets de ces 3 variables, Fullmetal Alchemist: Brotherhood semble être l’anime le mieux considéré par les utilisateurs de MyAnimeList (car le mieux noté, l’un des plus populaires, des plus notés et des plus représentés dans les favoris des membres).

Graphique n°9 :

point_plot_pop <- df_anime[df_anime$popularity != 0] %>%
  arrange(popularity) %>% head(n = 100) %>% 
  select(title, popularity, rank) %>%
  ggplot(aes(x = popularity, y = rank)) +
  geom_line(color = 'black') +
  geom_point(size = 2, color = 'red') +
  theme_ipsum() +
  theme(axis.title.x = element_text(size=14),
        axis.title.y = element_text(size=14)) +
  scale_x_continuous(
    expand = c(0, 0),
    limits = c(-1, 101),
    breaks = seq(0, 100, 5)
  ) +
  scale_y_continuous(
    breaks = seq(0, 3000, 500),
    limits = c(0, 3000)
  ) +
  ggtitle('Top 100 anime with their rank score')
  
point_plot_pop <- ggplotly(point_plot_pop)
point_plot_pop

    Ce graphique reprend 2 des variables utilisées dans le graphique précédent, à savoir le rang et la popularité. Il représente les 100 anime les plus populaires et leur rang associé. On remarque par exemple que le 17e anime le plus populaire est pourtant assez bas dans le classement (rang 2827).

Graphique n°10 :

##                 title popularity rank score
## 1 Sword Art Online II         17 2827   7.2

score_density_dec <- date_data %>%
  select(decade, type, score) %>%
  filter(!is.na(decade), type == 'TV', score != 0) %>% 
  ggplot(aes(score, group = decade, fill = decade)) +
  geom_density(adjust = 1.25, alpha = .75) +
  theme_ipsum() +
  theme(
    legend.position='top',
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14),
  ) +
  scale_x_continuous(
    limits = c(0, 10),
    breaks = seq(0, 10, 2.5)
  ) +
  scale_y_continuous(
    expand = c(0, 0),
    limits = c(0, 1),
    breaks = seq(0, 1, 0.25)
  ) +
  ggtitle('TV anime score density by decade')

score_density_dec <- ggplotly(score_density_dec)
score_density_dec

    Ce graphique représente la distribution des notes par décennie. Le graphique en aires empilées peut comporte plusieurs séries. Il met à la fois l’accent sur les changements dans le temps et sur les totaux de chaque catégorie. Dans ce type de graphique une aire peut en cacher une autre, mais ici les formes des courbes permettent d’avoir un bon aperçu des valeurs mesurées.

    On remarque qu’au fil des décennies, les anime ont tendance à être de mieux en mieux notés. En revanche, les notes sont plus étalées, elles sont globalement mieux réparties, contrairement aux années 1960 à 1980 qui montrent une forte concentration des notes attribuées entre 6 et 7.

MOVIES

Graphique n°11 :

score_year_movie <- date_data %>% 
  filter(score != 0, scored_by > 10, type == 'Movie') %>% 
  group_by("Year" = year) %>% 
  summarise(avg = round(mean(score, na.rm = T), 2)) %>%
  ggplot(aes(x = Year, y = avg)) +
  geom_line(color = 'red', size = 1) +
  theme_ipsum() +
  theme(axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14)) +
  scale_x_continuous(
    expand = c(0, 0),
    limits = c(1930, 2017),
    breaks = seq(1930, 2017, 25)
  ) +
  scale_y_continuous(
    breaks = seq(4.5, 7.5, 0.5),
    limits = c(4.5, 7.5)
  ) +
  labs(title = "Average score per year", y = "Average score")


score_year_movie <- ggplotly(score_year_movie)
score_year_movie

    Ce line chart représente l’évolution des notes au cours du temps. Contrairement à la tendance général de la moyenne des notes des animés, celle des films ont continuer à s’améliorer au cours du temps. Cette evolution peut-être attribuer à l’amélioration des techniques d’animation et l’augmentation de leurs popularité.

Graphique n°12 :

ratings_movie_decade <- date_data %>%
  filter(!is.na(decade), type == "Movie") %>% 
  group_by("Decade" = decade, rating, .drop = F) %>% 
  summarise(Freq = n()) %>%
  ggplot(aes(x = Decade, y = Freq, group = rating, shape = rating, color = rating)) +
  geom_line(size = 1) +
  geom_point(size = 2) +
  theme_ipsum() +
  theme(axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14)) +
  scale_y_continuous(
    breaks = seq(0, 300, 50),
    limits = c(0, 300)
  ) +
  ggtitle("Ratings evolution during decades")

ratings_movie_decade <- ggplotly(ratings_movie_decade)
ratings_movie_decade

    Ce graphique représente l’évolution de la classification au fil des décennies des films d’animations. On remarque rapidement que la tendance des films suit celle de la moyenne des autre catégories que nous avons vus au graphique n°7. En revanche il y a eu une nette augmentation du nombre de film pour tout age comparer au graphique n°7.

Graphique n°13 :

score_density_movie <- date_data %>% 
  filter(!is.na(decade), type == 'Movie', score != 0) %>% 
  select(decade, type, score) %>% 
  ggplot(aes(score, group = decade, fill = decade)) +
  geom_density(adjust = 1.25, alpha = .7) +
  theme_ipsum() +
  theme(
    legend.position='top',
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14),
  ) +
  scale_x_continuous(
    limits = c(0, 10),
    breaks = seq(0, 10, 2.5)
  ) +
  scale_y_continuous(
    expand = c(0, 0),
    limits = c(0, 1),
    breaks = seq(0, 1, 0.25)
  ) +
  ggtitle("Movies score density by decade")

score_density_movie <- ggplotly(score_density_movie)
score_density_movie

    Ce graphique représente la densiter des scored par décennie des films d’animation. Dans ce type de graphique une aire à tendance à en cacher une autre mais ici, les formes des courbes et les interactions permettent un bon aperçu de chacune d’entre elles.

USERS

Graphique n°14 :

box_gender_age <- users %>% 
  ggplot(aes(x = gender, y = age, fill = gender)) +
  geom_boxplot() +
  theme_ipsum() +
  theme(
    legend.position='none',
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14)
  ) +
  scale_y_continuous(
    expand = c(0, 0),
    limits = c(-1, 60),
    breaks = seq(0, 60, 5)
  ) +
  ylab("Age")

box_gender_age <- ggplotly(box_gender_age)

box_gender_spent <- users %>% 
  ggplot(aes(x = gender, y = user_days_spent_watching, fill = gender)) +
  geom_boxplot() +
  theme_ipsum() +
  theme(
    legend.position = 'none',
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14)
  ) +
  scale_y_continuous(
    expand = c(0, 0),
    limits = c(-1, 301),
    breaks = seq(0, 300, 50)
  ) +
  labs(title = "Users' age and days spent by gender", y = "Time spent (in days)")

box_gender_spent <- ggplotly(box_gender_spent)

subplot <- subplot(box_gender_age, box_gender_spent, nrows=1, titleY = T, margin = 0.07)
subplot

Graphique n°15 :

scatter_age <- users %>%
  ggplot(aes(x = age, y = user_days_spent_watching, color = gender)) +
  stat_bin_hex(bins = 75, alpha = 0.6)  +
  scale_color_manual(values= c('red', 'blue')) +
  theme_ipsum() +
  theme(
    legend.position = 'none',
    axis.title.x = element_text(size=14),
    axis.title.y = element_text(size=14),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank()
  ) +
  scale_x_continuous(
    expand = c(0, 0),
    limits = c(-1, 81),
    breaks = seq(0, 80, 5)
  ) +
  scale_y_continuous(
    expand = c(0, 0),
    limits = c(-1, 1001),
    breaks = seq(0, 1000, 200)
  ) +
  labs(title = "Anime watchers' age", x = "Age", y = "Time spent (in days)")
  
scatter_age <- ggplotly(scatter_age)
scatter_age